home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / pistol.zip / PISTF.C < prev    next >
Text File  |  1987-08-20  |  6KB  |  273 lines
  1. /*********************************************************/
  2. /*                             */
  3. /* PISTOL-Portably Implemented Stack Oriented Language     */
  4. /*            Version 1.3             */
  5. /* (C) 1982 by    Ernest E. Bergmann             */
  6. /*        Physics, Building #16             */
  7. /*        Lehigh Univerisity             */
  8. /*        Bethlehem, Pa. 18015             */
  9. /*                             */
  10. /* Permission is hereby granted for all reproduction and */
  11. /* distribution of this material provided this notice is */
  12. /* is included.                         */
  13. /*                             */
  14. /*********************************************************/
  15.  
  16. /* sixth and final module in BDS 'C', February, 1982 */
  17.  
  18. #include "bdscio.h"
  19. #include "pistol.h"
  20.  
  21. synterr()
  22. {ram[-14].in=TRU;if(ram[-24].in)carret();
  23.     if((ram[-11].in) && (ram[-13].in==FALS))
  24.         message(&strings[LINEBUF]);
  25.     merr(synt);
  26. }
  27.  
  28. pushck(chkch)
  29. char chkch;
  30. { if(CHKLMT>(++strings[1])) strings[1+strings[1]]=chkch;
  31. else{ram[-14].in=TRU; message(ovflo); synterr();}
  32. }
  33.  
  34. aloop()
  35. {if(lstack[lptr]<lstack[lptr-1]){Pw=ip;ip += *Pw; }
  36. else{lptr -=3; if(lptr<0) merr(undflo); ip +=W ; }
  37. }
  38.  
  39. pdo()
  40. {drop(); drop();
  41.     if(stack[stkptr+2]<stack[stkptr+1])
  42.     {lpush(stack[stkptr+2]);
  43.     lpush(stack[stkptr+1]);
  44.     lpush(stack[stkptr+2]); ip += W;
  45.     }
  46.     else{ Pw=ip; ip += *Pw; }
  47. }
  48.  
  49. dropck()
  50. {if(strings[1]) strings[1]--; else synterr(); }
  51.  
  52. geoln() /* Feb 17 */
  53. {    while(*ram[-15].pc != NEWLINE) ram[-15].pc++;
  54. }
  55.  
  56. move(as,ad,nowd)
  57. int as,ad,nowd;
  58. {int endaddr;
  59.     endaddr=as+nowd; Pw=as; Pw2=ad;
  60.     while(Pw <= endaddr)
  61.     { *Pw2=*Pw ; Pw++; Pw2++;}
  62. }
  63.  
  64. swap() /* Feb 17 */
  65. {Pc=stack[stkptr];stack[stkptr]=stack[stkptr-1];
  66.     stack[stkptr-1]=Pc;
  67. }
  68.  
  69. permstrings()
  70. {    if(ram[-5].pc<ram[-4].pc) ram[-5].pc=ram[-4].pc;
  71. }
  72.  
  73. enter() /* Feb 17 eliminate Pw */
  74. {drop();temp=find(stack[stkptr+1]);
  75. if(temp){message(redef);spaces(3);
  76.     message(stack[stkptr+1]);carret();
  77.     }append(0);
  78.     append((*ram[-6].pw).in);
  79.     append(stack[stkptr+1]);
  80.     append(COMPHERE);
  81.     (*ram[-6].pw).in=ram[-3].in;
  82. }
  83.  
  84. fenter(i) /* Feb 17, shortened */
  85. int i;
  86. { Pw = (*ram[-6].pw).pw - 4 ; *Pw = i ; }
  87.  
  88. getline()
  89. {if(!ram[-11].in)
  90.     {/* input from console*/
  91.     cinline();
  92.     }
  93. else
  94.     {/*input from file*/
  95.     finline(ldfil1,&Pc);    /*Pc can get*/
  96.     }            /*clobbered if eof*/
  97. if(ram[-13].in&&ram[-11].in) message(&strings[LINEBUF]);
  98. }
  99.  
  100. lpush(item)
  101. int item;
  102. {if(LSIZE<= ++lptr) merr(ovflo); lstack[lptr]=item;}
  103.  
  104. cpush(item)
  105. int item;
  106. {if(CSIZE<= ++cptr) merr(ovflo); cstack[cptr]=item; }
  107.  
  108. touchup()
  109. {int val;
  110.     Pw=val=stack[stkptr];drop();*Pw=ram[-2].in-val; }
  111.  
  112. fwdref()
  113. { push(ram[-2].in); compile(0); }
  114.  
  115. compile(address) /* Feb 17 */
  116. int address;
  117. { if(ram[-2].pw >= &ram[RAMSIZE-2]) merr(ovflo);
  118.  Pw=ram[-2].pw++ ; *Pw=address;
  119. }
  120.  
  121.  
  122.  
  123. /* addstring - convenience for initialization phase to emplace
  124.     string and update ram[-4]
  125. */
  126. char *addstring(length,string)
  127. int length;
  128. char *string;
  129. {
  130. int i;
  131. char *start;
  132.     start=ram[-4].pc++;
  133.     movmem(string,ram[-4].pc,length);
  134.     ram[-4].pc += length;
  135.     permstrings();
  136.     *start=length;
  137.     return(start);
  138. }
  139.  
  140. append(item)    /* place item at end of dictionary */
  141. int    item;    /* doesn't check for overflow yet, Feb 17 */
  142. {
  143.     (*ram[-3].pw).in=item;
  144.     ram[-3].pw++;
  145. }
  146.  
  147. penter(length, name, opcode) /* Feb 17 */
  148. int    length,opcode;
  149. char    *name;
  150. {
  151.     Pc=addstring(length,name);
  152.     append(0);
  153.     append((*ram[-6].pw).in);
  154.     append(Pc);
  155.     if(opcode<0)
  156.     {append(-opcode);append(PSEMICOLON);}
  157.     else
  158.     {append(COMPME);append(opcode);}
  159.     (*ram[-6].pw).pw = ram[-3].pw - 1 ;
  160.     fenter(ram[-3].in);
  161. }
  162.  
  163. carret()    /* outputs the CR-LF sequence*/
  164. {    if(ram[-14].in)
  165.     {    if(ram[-21].in == ++ram[-22].in)
  166.         {ram[-22].in=0;
  167.         cinline(); Pc =ram[-15].pc;
  168.         if('Q' == toupper(*Pc)) abort();
  169.         }
  170.         ram[-24].in=0;
  171.         printf("\n");
  172.     }
  173.     if(ram[-12].in) fprintf(list,"\n");
  174. }
  175.  
  176. merr(m)
  177. char *m;
  178. {    ram[-14].in=TRU;
  179.     if(ram[-24].in) carret();
  180.     message(m);
  181.     abort();
  182. }
  183.  
  184. message(st)
  185. char *st;
  186. {char *last;
  187. char len;
  188.     len=*st;
  189.     last=st + *st;
  190.     while(st < last){st++; chout(*st);}
  191. }
  192.  
  193. drop()
  194. {    if(stkptr<1)merr(undflo);
  195.     else stkptr--;
  196. }
  197.  
  198. push(item)
  199. int item;
  200. {    if(++stkptr >= SSIZE) merr(ovflo);
  201.     stack[stkptr]=item;
  202. }
  203.  
  204. rpush(item)
  205. int item;
  206. {    if(++rptr >= RSIZE) merr(ovflo);
  207.     rstack[rptr]=item;
  208. }
  209.  
  210. chout(ch)
  211. char ch;
  212. {    if(ch == 13) carret();
  213.     else if(ch == 9) tab();
  214.     else{if(ram[-24].in==ram[-23].in)carret();
  215.         ram[-24].in++;
  216.         if(ram[-14].in)putc(ch,1);
  217.         if(ram[-12].in)putc(ch,list);
  218.     }
  219. }
  220.  
  221. tab()
  222. {    if(ram[-27].in>0)
  223.     spaces(ram[-27].in-ram[-24].in%ram[-27].in);
  224. }
  225.  
  226. spaces(num)
  227. int num;
  228. {    while(num>0){chout(' ');num--;}
  229. }
  230.  
  231. cinline()    /*input line from console*/
  232. {    ram[-15].pc=&strings[LINEBUF+1];
  233.     ram[-16].in=1+strlen(gets(&strings[LINEBUF+1]));
  234.     Pc=&strings[LINEBUF];
  235.     *Pc=ram[-16].in;
  236.     Pc += ram[-16].in;
  237.     *Pc=NEWLINE; Pc++ ;
  238.     *Pc=10 ; Pc++ ;
  239.     *Pc = 0;
  240.     if(ram[-12].in)fputs(ram[-15].pc,list);
  241. }
  242.  
  243. finline(iobuf,iostat)
  244. char *iobuf;
  245. int *iostat;    /*not used anymore ???*/
  246. {    ram[-15].pc=fgets(&strings[LINEBUF+1],iobuf);
  247.     if(!ram[-15].in) merr(feof);
  248.     ram[-16].in=strlen(ram[-15].pc);
  249.     Pc=&strings[LINEBUF];
  250.     *Pc=ram[-16].in;
  251.     Pc += ram[-16].in;
  252.     *Pc=NEWLINE; Pc++ ;
  253.     *Pc=10; Pc++ ;
  254.     *Pc=0 ;
  255. }
  256.  
  257. eof(iobuf)    /* used to test for eof status on */
  258. char *iobuf;    /* buffered i/o in analogy to PASCAL*/
  259. {int c;
  260.     c=getc(iobuf);
  261.     if((c == ERROR) || (c== CPMEOF)) return(TRU);
  262.     ungetc(c,iobuf);
  263.     return(FALS);
  264. }
  265.  
  266. ram[-14].in)putc(ch,1);
  267.         if(ram[-12].in)putc(ch,list);
  268.     }
  269. }
  270.  
  271. tab()
  272. {    if(ram[-27].in>0)
  273.     spaces(ram[-27].in-ram[-24].in